1. Overview
In this take-home exercise, a selected Tableau visualization
submitted by classmate in take-home exercise 1 is reviewed based on its
clarity and aesthetics.
Constructive suggestions are given based on
data visualization design principles and best practices learned in
Lesson 1 and 2. An alternative design is also proposed to help improve
on the original visual. Instead of Tableau, the proposed design is
produced using ggplot2, ggplot2 extensions and tidyverse packages.
a. Load the required libraries
results <- 'hide'
packages = c('tidyverse', 'plotly', 'ggthemes', "knitr", "rmarkdown")
for(p in packages){
if(!require(p,character.only = T)){
install.packages(p)
}
library(p,character.only = T)
}
b. Import the data
data2022 <- read_csv("respopagesextod2022.csv")
Rows: 100928 Columns: 7── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr (5): Planning_Areas, SubZone, Age_Group, Sex, Type_of_Dwelling
dbl (2): Population, Time
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(data2022)
c. Group data by planning area, age group and gender
data2022$Age_Group <- factor (data2022$Age_Group, levels = unique(data2022$Age_Group))
data2022$Planning_Areas <- factor (data2022$Planning_Areas, levels = unique(data2022$Planning_Areas))
data_grp <- data2022 %>%
group_by(`Planning_Areas`, `Age_Group`, `Sex`) %>%
summarise('Population_Count'= sum(`Population`)) %>%
ungroup()
`summarise()` has grouped output by 'Planning_Areas', 'Age_Group'. You can override using the `.groups` argument.
paged_table(data_grp)
d. Select the top 9 planning areas by population count
top9PA <- data_grp %>%
group_by(Planning_Areas) %>%
summarise(count = sum(Population_Count)) %>%
arrange(desc(count),.by_group = TRUE) %>%
top_n(9,count)
data_top9 <- data_grp[data_grp$Planning_Areas %in% top9PA$Planning_Areas,]
print(unique(data_top9$Planning_Areas))
e. Converting population count of males to negative.
In order to plot age-sex pyramids, we need to convert the population
count for one of the gender to negative. As we want “Male” to appear on
the left side of the pyramids, as to mimic the original visual, we will
convert male population count to negative using the mutate function.
data_males <- data_top9 %>%
filter(`Sex` == "Males") %>%
mutate (Population_Count = -Population_Count)
f. Combining the converted males population count to female
population count.
data_females <- data_top9 %>%
filter(`Sex` == "Females")
data_transform <- rbind(data_males,data_females)
g. Plotting the age-sex pyramid.
xbrks <- seq(-15000, 15000, 5000)
xlabls <- paste0(as.character(c(seq(15, 0, -5), seq(5, 15, 5))),"k")
my_colors <- c("salmon","skyblue")
p <-ggplot(data_transform, aes (x = reorder(Age_Group, desc(Age_Group)), y = Population_Count, fill = Sex)) +
geom_bar(stat = "identity", width = .7) +
facet_wrap (~ Planning_Areas, nrow = 3, ncol = 3) +
scale_y_continuous(breaks = xbrks, labels = xlabls, name = "Population Count") +
xlab("Age\nGroups") +
coord_flip() +
theme_bw() + scale_fill_manual(values = my_colors) +
labs(title = "Age-sex pyramids of top 9 planning areas by population count in Singapore, June 2022")
p1 <- p + theme(axis.text = element_text(size=16),
axis.title = element_text(size =21),
axis.title.y= element_text(angle=0),
axis.ticks.y = element_blank(),
strip.text = element_text(size=22),
plot.title = element_text(size=29, hjust = 0.5),
legend.key.size = unit(2, 'cm'),
legend.title = element_text(size=21),
legend.text = element_text(size=16),
legend.position = "right")
show(p1)

h. Adding interactivity.
p2 <- p + theme(axis.text = element_text(size=5.5),
axis.title = element_text(size =9),
axis.title.y= element_text(angle=0),
axis.ticks.y = element_blank(),
strip.text = element_text(size=8),
plot.title = element_text(size=10, hjust = 0.5),
legend.key.size = unit(1, 'cm'),
legend.title = element_text(size=9),
legend.text = element_text(size=6),
legend.position = "right")
ggplotly(p2)
LS0tDQp0aXRsZTogIlRha2UgSG9tZSBFeGVyY2lzZSAyIg0KYXV0aG9yOiAiTGF3IFNoaWFuZyBSb3UiDQpkYXRlOiAiYHIgU3lzLkRhdGUoKWAiDQpvdXRwdXQ6DQogIGh0bWxfbm90ZWJvb2s6DQogICAgY29kZV9mb2xkaW5nOiBoaWRlDQotLS0NCg0KIyMgWyoqMS4gT3ZlcnZpZXcqKl17c3R5bGU9ImNvbG9yOiBOYXZ5OyJ9DQoNCkluIHRoaXMgdGFrZS1ob21lIGV4ZXJjaXNlLCBhIHNlbGVjdGVkIFRhYmxlYXUgdmlzdWFsaXphdGlvbiBzdWJtaXR0ZWQgYnkgY2xhc3NtYXRlIGluIHRha2UtaG9tZSBleGVyY2lzZSAxIGlzIHJldmlld2VkIGJhc2VkIG9uIGl0cyBjbGFyaXR5IGFuZCBhZXN0aGV0aWNzLjxicj4NCkNvbnN0cnVjdGl2ZSBzdWdnZXN0aW9ucyBhcmUgZ2l2ZW4gYmFzZWQgb24gZGF0YSB2aXN1YWxpemF0aW9uIGRlc2lnbiBwcmluY2lwbGVzIGFuZCBiZXN0IHByYWN0aWNlcyBsZWFybmVkIGluIExlc3NvbiAxIGFuZCAyLiBBbiBhbHRlcm5hdGl2ZSBkZXNpZ24gaXMgYWxzbyBwcm9wb3NlZCB0byBoZWxwIGltcHJvdmUgb24gdGhlIG9yaWdpbmFsIHZpc3VhbC4gSW5zdGVhZCBvZiBUYWJsZWF1LCB0aGUgcHJvcG9zZWQgZGVzaWduIGlzIHByb2R1Y2VkIHVzaW5nIGdncGxvdDIsIGdncGxvdDIgZXh0ZW5zaW9ucyBhbmQgdGlkeXZlcnNlIHBhY2thZ2VzLg0KDQojIyMjIGEuIExvYWQgdGhlIHJlcXVpcmVkIGxpYnJhcmllcw0KDQpgYGB7ciBtZXNzYWdlID0gRkFMU0V9DQpyZXN1bHRzIDwtICdoaWRlJw0KcGFja2FnZXMgPSBjKCd0aWR5dmVyc2UnLCAncGxvdGx5JywgJ2dndGhlbWVzJywgImtuaXRyIiwgInJtYXJrZG93biIpDQpmb3IocCBpbiBwYWNrYWdlcyl7DQogIGlmKCFyZXF1aXJlKHAsY2hhcmFjdGVyLm9ubHkgPSBUKSl7DQogICAgaW5zdGFsbC5wYWNrYWdlcyhwKQ0KICB9DQogIGxpYnJhcnkocCxjaGFyYWN0ZXIub25seSA9IFQpDQp9DQpgYGANCg0KIyMjIyBiLiBJbXBvcnQgdGhlIGRhdGENCmBgYHtyfQ0KZGF0YTIwMjIgPC0gcmVhZF9jc3YoInJlc3BvcGFnZXNleHRvZDIwMjIuY3N2IikNCmhlYWQoZGF0YTIwMjIpDQpgYGANCg0KIyMjIyBjLiBHcm91cCBkYXRhIGJ5IHBsYW5uaW5nIGFyZWEsIGFnZSBncm91cCBhbmQgZ2VuZGVyDQpgYGB7cn0NCmRhdGEyMDIyJEFnZV9Hcm91cCA8LSBmYWN0b3IgKGRhdGEyMDIyJEFnZV9Hcm91cCwgbGV2ZWxzID0gdW5pcXVlKGRhdGEyMDIyJEFnZV9Hcm91cCkpIA0KZGF0YTIwMjIkUGxhbm5pbmdfQXJlYXMgPC0gZmFjdG9yIChkYXRhMjAyMiRQbGFubmluZ19BcmVhcywgbGV2ZWxzID0gdW5pcXVlKGRhdGEyMDIyJFBsYW5uaW5nX0FyZWFzKSkgDQpkYXRhX2dycCA8LSBkYXRhMjAyMiAlPiUNCiAgICAgICAgICAgICAgICAgICAgZ3JvdXBfYnkoYFBsYW5uaW5nX0FyZWFzYCwgYEFnZV9Hcm91cGAsIGBTZXhgKSAlPiUNCiAgICAgICAgICAgICAgICAgICAgc3VtbWFyaXNlKCdQb3B1bGF0aW9uX0NvdW50Jz0gc3VtKGBQb3B1bGF0aW9uYCkpICU+JQ0KICAgICAgICAgICAgICAgICAgICB1bmdyb3VwKCkNCnBhZ2VkX3RhYmxlKGRhdGFfZ3JwKQ0KYGBgDQoNCiMjIyMgZC4gU2VsZWN0IHRoZSB0b3AgOSBwbGFubmluZyBhcmVhcyBieSBwb3B1bGF0aW9uIGNvdW50DQpgYGB7cn0NCnRvcDlQQSA8LSBkYXRhX2dycCAlPiUNCiAgZ3JvdXBfYnkoUGxhbm5pbmdfQXJlYXMpICU+JQ0KICBzdW1tYXJpc2UoY291bnQgPSBzdW0oUG9wdWxhdGlvbl9Db3VudCkpICU+JQ0KICBhcnJhbmdlKGRlc2MoY291bnQpLC5ieV9ncm91cCA9IFRSVUUpICU+JQ0KICB0b3Bfbig5LGNvdW50KQ0KDQpkYXRhX3RvcDkgPC0gZGF0YV9ncnBbZGF0YV9ncnAkUGxhbm5pbmdfQXJlYXMgJWluJSB0b3A5UEEkUGxhbm5pbmdfQXJlYXMsXQ0KcHJpbnQodW5pcXVlKGRhdGFfdG9wOSRQbGFubmluZ19BcmVhcykpDQpgYGANCg0KIyMjIyBlLiBDb252ZXJ0aW5nIHBvcHVsYXRpb24gY291bnQgb2YgbWFsZXMgdG8gbmVnYXRpdmUuDQpJbiBvcmRlciB0byBwbG90IGFnZS1zZXggcHlyYW1pZHMsIHdlIG5lZWQgdG8gY29udmVydCB0aGUgcG9wdWxhdGlvbiBjb3VudCBmb3Igb25lIG9mIHRoZSBnZW5kZXIgdG8gbmVnYXRpdmUuIEFzIHdlIHdhbnQgIk1hbGUiIHRvIGFwcGVhciBvbiB0aGUgbGVmdCBzaWRlIG9mIHRoZSBweXJhbWlkcywgYXMgdG8gbWltaWMgdGhlIG9yaWdpbmFsIHZpc3VhbCwgd2Ugd2lsbCBjb252ZXJ0IG1hbGUgcG9wdWxhdGlvbiBjb3VudCB0byBuZWdhdGl2ZSB1c2luZyB0aGUgbXV0YXRlIGZ1bmN0aW9uLg0KYGBge3J9DQpkYXRhX21hbGVzIDwtIGRhdGFfdG9wOSAlPiUNCiAgZmlsdGVyKGBTZXhgID09ICAiTWFsZXMiKSAlPiUNCiAgbXV0YXRlIChQb3B1bGF0aW9uX0NvdW50ID0gLVBvcHVsYXRpb25fQ291bnQpDQpgYGANCg0KIyMjIyBmLiBDb21iaW5pbmcgdGhlIGNvbnZlcnRlZCBtYWxlcyBwb3B1bGF0aW9uIGNvdW50IHRvIGZlbWFsZSBwb3B1bGF0aW9uIGNvdW50Lg0KYGBge3J9DQpkYXRhX2ZlbWFsZXMgPC0gZGF0YV90b3A5ICU+JQ0KICBmaWx0ZXIoYFNleGAgPT0gICJGZW1hbGVzIikgDQpkYXRhX3RyYW5zZm9ybSA8LSByYmluZChkYXRhX21hbGVzLGRhdGFfZmVtYWxlcykNCmBgYA0KDQojIyMjIGcuIFBsb3R0aW5nIHRoZSBhZ2Utc2V4IHB5cmFtaWQuDQpgYGB7ciBmaWcuaGVpZ2h0ID0gMjAsIGZpZy53aWR0aCA9IDIwLCBhbGlnbiA9ICJjZW50ZXIifQ0KeGJya3MgPC0gc2VxKC0xNTAwMCwgMTUwMDAsIDUwMDApDQp4bGFibHMgPC0gcGFzdGUwKGFzLmNoYXJhY3RlcihjKHNlcSgxNSwgMCwgLTUpLCBzZXEoNSwgMTUsIDUpKSksImsiKQ0KbXlfY29sb3JzIDwtIGMoInNhbG1vbiIsInNreWJsdWUiKQ0KcCA8LWdncGxvdChkYXRhX3RyYW5zZm9ybSwgYWVzICh4ID0gcmVvcmRlcihBZ2VfR3JvdXAsIGRlc2MoQWdlX0dyb3VwKSksIHkgPSBQb3B1bGF0aW9uX0NvdW50LCBmaWxsID0gU2V4KSkgKw0KICAgIGdlb21fYmFyKHN0YXQgPSAiaWRlbnRpdHkiLCB3aWR0aCA9IC43KSArDQogICAgZmFjZXRfd3JhcCAofiBQbGFubmluZ19BcmVhcywgbnJvdyA9IDMsIG5jb2wgPSAzKSArIA0KICAgIHNjYWxlX3lfY29udGludW91cyhicmVha3MgPSB4YnJrcywgbGFiZWxzID0geGxhYmxzLCBuYW1lID0gIlBvcHVsYXRpb24gQ291bnQiKSArDQogICAgeGxhYigiQWdlXG5Hcm91cHMiKSArDQogICAgY29vcmRfZmxpcCgpICsgDQogICAgdGhlbWVfYncoKSArIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcyA9IG15X2NvbG9ycykgKyANCiAgICBsYWJzKHRpdGxlID0gIkFnZS1zZXggcHlyYW1pZHMgb2YgdG9wIDkgcGxhbm5pbmcgYXJlYXMgYnkgcG9wdWxhdGlvbiBjb3VudCBpbiBTaW5nYXBvcmUsIEp1bmUgMjAyMiIpIA0KcDEgPC0gcCArIHRoZW1lKGF4aXMudGV4dCA9IGVsZW1lbnRfdGV4dChzaXplPTE2KSwgDQogICAgICAgICAgYXhpcy50aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplID0yMSksDQogICAgICAgICAgYXhpcy50aXRsZS55PSBlbGVtZW50X3RleHQoYW5nbGU9MCksDQogICAgICAgICAgYXhpcy50aWNrcy55ID0gZWxlbWVudF9ibGFuaygpLA0KICAgICAgICAgIHN0cmlwLnRleHQgPSBlbGVtZW50X3RleHQoc2l6ZT0yMiksDQogICAgICAgICAgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplPTI5LCBoanVzdCA9IDAuNSksDQogICAgICAgICAgbGVnZW5kLmtleS5zaXplID0gdW5pdCgyLCAnY20nKSwNCiAgICAgICAgICBsZWdlbmQudGl0bGUgPSBlbGVtZW50X3RleHQoc2l6ZT0yMSksDQogICAgICAgICAgbGVnZW5kLnRleHQgPSBlbGVtZW50X3RleHQoc2l6ZT0xNiksDQogICAgICAgICAgbGVnZW5kLnBvc2l0aW9uID0gInJpZ2h0IikgIA0KICAgIA0Kc2hvdyhwMSkNCmBgYA0KIyMjIyBoLiBBZGRpbmcgaW50ZXJhY3Rpdml0eS4NCmBgYHtyfQ0KcDIgPC0gcCArIHRoZW1lKGF4aXMudGV4dCA9IGVsZW1lbnRfdGV4dChzaXplPTUuNSksIA0KICAgICAgICAgIGF4aXMudGl0bGUgPSBlbGVtZW50X3RleHQoc2l6ZSA9OSksDQogICAgICAgICAgYXhpcy50aXRsZS55PSBlbGVtZW50X3RleHQoYW5nbGU9MCksDQogICAgICAgICAgYXhpcy50aWNrcy55ID0gZWxlbWVudF9ibGFuaygpLA0KICAgICAgICAgIHN0cmlwLnRleHQgPSBlbGVtZW50X3RleHQoc2l6ZT04KSwNCiAgICAgICAgICBwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KHNpemU9MTAsIGhqdXN0ID0gMC41KSwNCiAgICAgICAgICBsZWdlbmQua2V5LnNpemUgPSB1bml0KDEsICdjbScpLA0KICAgICAgICAgIGxlZ2VuZC50aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplPTkpLA0KICAgICAgICAgIGxlZ2VuZC50ZXh0ID0gZWxlbWVudF90ZXh0KHNpemU9NiksDQogICAgICAgICAgbGVnZW5kLnBvc2l0aW9uID0gInJpZ2h0IikgIA0KZ2dwbG90bHkocDIpDQpgYGA=